Visualizations
July 24, 2019
Overview
This document contains code for creating and recreating Petra’s visualizaitons for the report.
To Do:
- put in the number of people in each of the groups
- change colors in plot to match Petra’s plots
- figure out if I need to site the protocol
Depiction of Large Continuous Dataset
# Get and order patient 2 data
pt2_data <- ds_cgm_complete %>%
select(pt_id,
visit,
visitnum,
device_visit_period_day,
device_tm,
device_tm_bin,
glucose_value) %>%
filter(pt_id == 2) %>%
arrange(visitnum, device_visit_period_day, device_tm_bin) %>%
group_by(visit) %>%
mutate(time_order = 1:n())One patient, one day
animate1 <- pt2_data %>%
filter(visitnum == 1, device_visit_period_day == 1) %>%
ggplot(aes(x = device_tm,
y = glucose_value,
color = visitnum)) +
geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
#scale_color_brewer(palette = "Paired") +
labs(x = "Time of Day", y = "Glucose Value (mg/dL)",
title = "Data for One Participant") +
theme(legend.position = "none",
text = element_text(size = 16)) +
transition_reveal(device_tm)anim_save(animate1, filename = "../figures/try/animate1.png")One patient, eight days (one visit period)
pt2_data %>%
filter(visitnum == 1) %>%
ggplot(aes(x = device_tm,
y = glucose_value,
color = as.factor(device_visit_period_day),
group = as.factor(device_visit_period_day))) +
geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
scale_color_brewer(palette = "Paired") +
labs(x = "Time of Day", y = "Glucose Value (mg/dL)") +
theme(legend.position = "none") +
transition_reveal(time_order)
pt2_data %>%
filter(visitnum == 1) %>%
ggplot(aes(x = device_tm,
y = glucose_value,
color = as.factor(visitnum),
group = as.factor(device_visit_period_day))) +
geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
labs(x = "Time of Day", y = "Glucose Value (mg/dL)") +
theme(legend.position = "none") +
scale_color_brewer(palette = "Paired") +
facet_wrap(device_visit_period_day ~ ., nrow = 2) +
transition_reveal(time_order)
One patient, all days and visits
pt2_data %>%
ggplot(aes(x = device_tm,
y = glucose_value,
color = as.factor(visit),
group = as.factor(device_visit_period_day))) +
geom_point(aes(group = seq_along(device_tm)), size = 0.5) +
labs(x = "Time of Day", y = "Glucose Value (mg/dL)",
title = "Data from One Participant") +
theme(legend.position = "none",
text = element_text(size = 16)) +
facet_wrap(visit ~ ., nrow = 2) +
scale_color_brewer(palette = "Paired") +
transition_reveal(time_order)
Study Design
Timeline
# Creates event data
study_events <- data.frame(week_num = c(-10, 0, 0, 3, 6, 13, 19, 26),
week_buffer = c(-10.05, 0, 0, 3, 6, 13, 19, 26.05),
week_name = c("Enrollment",
"Week 0",
"Week 0",
"Week 3",
"Week 6",
"Week 13",
"Week 19",
"Week 26"),
event = c("Screening Visit",
NA,
"Randomization 2:1 (Visit 0)",
"Visit 1",
"Visit 2",
"Visit 3",
"Visit 4",
"Visit 5"),
period = factor(c(rep("Run-In Phase", 2),
rep("Main Study", 6)),
levels = c("Run-In Phase",
"Main Study")),
week_ypos = rep(0, 8),
event_ypos = c(0.2, 0.3, 0.3, 0.2,
0.2, 0.2, 0.2, 0.2))
# Plots the events on a time line
study_timeline <- study_events %>%
ggplot(mapping = aes(x = week_num,
y = week_ypos,
color = period,
group = period,
label = event)) +
geom_segment(mapping = aes(y = week_ypos,
yend = event_ypos,
xend = week_num),
color = 'black',
size = 0.5) +
geom_point(aes(x = week_num,
y = event_ypos),
size = 3) +
geom_line(size = 6, aes(x = week_buffer)) +
geom_text(mapping = aes(x = week_num,
y = event_ypos,
label = event),
size = 5,
color = 'black',
vjust = -1) +
geom_text(mapping = aes(x = week_num,
y = -.02,
label = week_name),
size = 5,
color = 'black',
angle = 45,
vjust = 1.5,
hjust = 1) +
xlim(-12, 28) +
ylim(-0.2, 0.4) +
labs(color = "Study Period") +
theme_void() +
theme(legend.position = "bottom",
legend.title = element_text(size = 14),
legend.text = element_text(size = 12)) +
scale_color_brewer(palette = "Paired")
# Print the figure
study_timeline
# Save the figure for the report
ggsave(plot = study_timeline,
filename = "../figures/timeline.png",
width = 12,
height = 3)
# Save the figure for the presentation
ggsave(plot = study_timeline,
filename = "../figures/timeline_pres.png",
width = 9,
height = 3)All Curves for a Patient
# Plot of glucose values for 3 days and all visits for patient 70
pt_curves <- ds_cgm_complete_3days %>%
filter(pt_id == 70) %>%
ggplot(aes(x = device_tm,
y = glucose_value,
group = as.factor(device_dt_tm_days_from_enroll),
col = as.factor(visit))) +
facet_wrap(. ~ visit) +
geom_line(size = 0.25, show.legend = FALSE) +
theme_bw() +
geom_hline(yintercept = 70, color = "black", linetype = "dashed") +
geom_hline(yintercept = 180, color = "black", linetype = "dashed") +
scale_color_brewer(palette = "Paired") +
labs(x = "Time of Day", y = "Glucose Value (mg/dL)")
# Print the figure
pt_curves
# Save the figure
ggsave(plot = pt_curves,
filename = "../figures/pt_curves.png",
width = 6,
height = 4)Objective
# Create a plot showing summary statistic comparison
summary_stats <- ds_cgm_complete %>%
filter(visitnum == 5) %>%
group_by(trt_group, visitnum) %>%
summarise(mean_glucose = mean(glucose_value),
sd_glucose = sd(glucose_value)) %>%
ggplot(aes(x = trt_group, y = mean_glucose)) +
geom_errorbar(aes(ymin = mean_glucose - sd_glucose,
ymax = mean_glucose + sd_glucose),
width = 0.2, size = 0.75) +
geom_point(aes(color = trt_group), size = 5) +
scale_color_brewer(palette = "Paired") +
labs(x = "Treatment Group", y = "Glucose Value",
title = "Previous: Statistics Comparison") +
theme_classic() +
theme(text = element_text(size = 16),
legend.position = "none")
# Create a plot showing function comparison
fun_compare <- ds_cgm_complete %>%
filter(visitnum == 5, pt_id %in% c(2, 8)) %>%
ggplot(aes(x = device_tm, y = glucose_value,
color = trt_group, group = trt_group)) +
geom_smooth() +
scale_color_brewer(palette = "Paired") +
labs(x = "Time of Day", y = "Glucose Value", color = "Treatment Group",
title = "Our Goal: Function Comparison") +
theme_classic() +
theme(text = element_text(size = 16),
legend.position = "bottom")
# Extract the legend from the functional comparison plot
obj_legend <- get_legend(fun_compare)## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'# Join the objective plots
obj_plots <- plot_grid(summary_stats, fun_compare + theme(legend.position = "none"))## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'# Add the legend
obj_figure <- plot_grid(obj_plots, obj_legend,
nrow = 2,
rel_heights = c(0.9, 0.1))
# Print the figure
obj_figure
# Save the figure
ggsave(plot = obj_figure,
filename = "../figures/obj_figure.png",
width = 10,
height = 5)Data Structure and Preprocessing
Missing Visit Periods
# Plot the patients who have observations in a visit period
missed_visits <- ds_cgm %>%
select(pt_id, visitnum) %>%
distinct() %>%
ggplot(aes(x = visitnum, y = pt_id, fill = visitnum)) +
geom_tile() +
scale_fill_brewer(palette = "Paired") +
labs(x = "Visit Period",
y = "Participant",
fill = "Visit Period") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank())
# Print the figure
missed_visits
# Save the figure
ggsave(plot = missed_visits,
filename = "../figures/missed_visits.png",
width = 6,
height = 4)Missing Times
# Plot missing times during a day for one patient
missed_times <- ds_cgm_complete %>%
filter(pt_id == 70, visitnum == 5, device_visit_period_day == 2) %>%
right_join(data.frame(device_tm_bin = 1:288)) %>%
ggplot(aes(x = device_tm, y = glucose_value)) +
geom_path() +
labs(x = "Time of Day", y = "Glucose Value")
# Print the figure
missed_times
# Save the figure
ggsave(plot = missed_times,
filename = "../figures/missed_times.png",
width = 6,
height = 4)Demographics Table
#Relabel
var.labels <- c(gender = "Gender",
ethnicity = "Ethnicity",
diag_age = "Age at Diagnosis",
oth_gluc_lower_med = "Other Glucose Lowering Medication",
edu_level = "Highest Education Level",
weight = "Weight",
height = "Height",
cgm_use_status = "CGM Use",
pt_status = "Completed Study",
trt_group = "Treatment Group",
age_as_of_enroll_dt = "Age at Enrollment"
)
ds_subject <- Hmisc::upData(ds_subject, labels = var.labels) ## Input object size: 37968 bytes; 13 variables 226 observations
## New object size: 39544 bytes; 13 variables 226 observationscompareGroups(trt_group ~ pt_status + gender + ethnicity + diag_age + age_as_of_enroll_dt +
edu_level + weight + height + cgm_use_status,
data = ds_subject %>%
filter(pt_id %in% unique(ds_cgm_complete_3days$pt_id)),
include.miss = TRUE) %>%
createTable(show.p.overall = TRUE,
#hide = c("No"),
show.n = TRUE) %>%
export2latex(header.labels = c(p.overall = "p-value"))##
## \begin{longtable}{lcccc}\caption{Summary descriptives table by groups of `Treatment Group'}\\
## \hline
## & CGM Only & CGM+BGM & \multirow{2}{*}{p-value} & \multirow{2}{*}{ N }\\
## & N=131 & N=73 & & \\
##
## \hline
## \hline
## \endfirsthead
## \multicolumn{5}{l}{\tablename\ \thetable{} \textit{-- continued from previous page}}\\
## \hline
## & CGM Only & CGM+BGM & \multirow{2}{*}{p-value} & \multirow{2}{*}{ N }\\
## & N=131 & N=73 & & \\
##
## \hline
## \hline
## \endhead
## \hline
## \multicolumn{5}{l}{\textit{continued on next page}} \\
## \endfoot
## \multicolumn{5}{l}{} \\
## \endlastfoot
## Completed Study: Completed & 131 (100\%) & 73 (100\%) & . & 204\\
## Gender: & & & 0.327 & 204\\
## $\qquad$F & 61 (46.6\%) & 40 (54.8\%) & & \\
## $\qquad$M & 70 (53.4\%) & 33 (45.2\%) & & \\
## Ethnicity: & & & 0.100 & 204\\
## $\qquad$Hispanic or Latino & 2 (1.53\%) & 5 (6.85\%) & & \\
## $\qquad$Not Hispanic or Latino & 128 (97.7\%) & 68 (93.2\%) & & \\
## $\qquad$Unknown/not reported & 1 (0.76\%) & 0 (0.00\%) & & \\
## Age at Diagnosis & 20.4 (13.0) & 20.5 (12.6) & 0.960 & 204\\
## Age at Enrollment & 44.2 (14.0) & 45.0 (13.2) & 0.714 & 204\\
## Highest Education Level: & & & 0.554 & 204\\
## $\qquad$Associate Degree & 4 (3.05\%) & 3 (4.11\%) & & \\
## $\qquad$Bachelor's Degree & 64 (48.9\%) & 32 (43.8\%) & & \\
## $\qquad$Doctorate Degree & 3 (2.29\%) & 3 (4.11\%) & & \\
## $\qquad$High school graduate/diploma/GED & 4 (3.05\%) & 2 (2.74\%) & & \\
## $\qquad$Master's Degree & 28 (21.4\%) & 18 (24.7\%) & & \\
## $\qquad$Professional Degree & 6 (4.58\%) & 5 (6.85\%) & & \\
## $\qquad$Some college but no degree & 21 (16.0\%) & 7 (9.59\%) & & \\
## $\qquad$'Missing' & 1 (0.76\%) & 3 (4.11\%) & & \\
## Weight & 83.5 (15.4) & 78.1 (15.7) & 0.020 & 204\\
## Height & 173 (10.7) & 172 (10.6) & 0.655 & 204\\
## CGM Use: & & & 0.872 & 204\\
## $\qquad$Current & 61 (46.6\%) & 36 (49.3\%) & & \\
## $\qquad$In past, but not current & 46 (35.1\%) & 23 (31.5\%) & & \\
## $\qquad$Never & 24 (18.3\%) & 14 (19.2\%) & & \\
##
## \hline
## \end{longtable}Comparing Treatments
ds_cgm_complete %>%
group_by(visitnum, trt_group) %>%
summarise(mean_glucose = mean(glucose_value)) %>%
ggplot(aes(x = visitnum, y = mean_glucose,
color = trt_group, group = trt_group)) +
geom_point() +
geom_line()
Other
ds_cgm_complete %>%
filter(pt_id %in% c(2, 3)) %>%
filter(visitnum == 5) %>%
select(pt_id, device_dt_tm_days_from_enroll) %>%
ggplot(aes(x = device_dt_tm_days_from_enroll, y = pt_id)) +
geom_point()
Session Info
## R version 3.6.1 (2019-07-05)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Mojave 10.14.5
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] scales_1.0.0 lubridate_1.7.4 ggrepel_0.8.1
## [4] gganimate_1.0.3 forcats_0.4.0 dplyr_0.8.1
## [7] cowplot_0.9.4 ggplot2_3.2.0 compareGroups_4.1.0
## [10] SNPassoc_1.9-2 mvtnorm_1.0-10 survival_2.44-1.1
## [13] haplo.stats_1.7.9
##
## loaded via a namespace (and not attached):
## [1] nlme_3.1-140 rms_5.1-3.1 webshot_0.5.1
## [4] RColorBrewer_1.1-2 progress_1.2.2 httr_1.4.0
## [7] tools_3.6.1 backports_1.1.4 R6_2.4.0
## [10] rpart_4.1-15 mgcv_1.8-28 Hmisc_4.2-0
## [13] lazyeval_0.2.2 colorspace_1.4-1 jomo_2.6-8
## [16] nnet_7.3-12 withr_2.1.2 prettyunits_1.0.2
## [19] tidyselect_0.2.5 gridExtra_2.3 compiler_3.6.1
## [22] chron_2.3-53 rvest_0.3.4 quantreg_5.40
## [25] htmlTable_1.13.1 HardyWeinberg_1.6.3 mice_3.6.0
## [28] SparseM_1.77 xml2_1.2.0 sandwich_2.5-1
## [31] labeling_0.3 checkmate_1.9.3 polspline_1.1.15
## [34] readr_1.3.1 epitools_0.5-10 stringr_1.4.0
## [37] digest_0.6.20 foreign_0.8-71 minqa_1.2.4
## [40] rmarkdown_1.13 base64enc_0.1-3 pkgconfig_2.0.2
## [43] htmltools_0.3.6 lme4_1.1-21 htmlwidgets_1.3
## [46] rlang_0.4.0 rstudioapi_0.10 farver_1.1.0
## [49] generics_0.0.2 zoo_1.8-6 acepack_1.4.1
## [52] magrittr_1.5 kableExtra_1.1.0 Formula_1.2-3
## [55] Matrix_1.2-17 Rcpp_1.0.1 munsell_0.5.0
## [58] stringi_1.4.3 multcomp_1.4-10 yaml_2.2.0
## [61] MASS_7.3-51.4 plyr_1.8.4 grid_3.6.1
## [64] mitml_0.3-7 crayon_1.3.4 lattice_0.20-38
## [67] splines_3.6.1 hms_0.5.0 zeallot_0.1.0
## [70] knitr_1.23 pillar_1.4.2 boot_1.3-22
## [73] codetools_0.2-16 pan_1.6 glue_1.3.1
## [76] evaluate_0.14 latticeExtra_0.6-28 gifski_0.8.6
## [79] data.table_1.12.2 png_0.1-7 tweenr_1.0.1
## [82] vctrs_0.2.0 nloptr_1.2.1 MatrixModels_0.4-1
## [85] gtable_0.3.0 purrr_0.3.2 tidyr_0.8.3
## [88] assertthat_0.2.1 xfun_0.8 broom_0.5.2
## [91] Rsolnp_1.16 viridisLite_0.3.0 truncnorm_1.0-8
## [94] tibble_2.1.3 cluster_2.1.0 writexl_1.1
## [97] TH.data_1.0-10